home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / doio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-01  |  30.8 KB  |  1,562 lines  |  [TEXT/MPS ]
  1. /*    doio.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Far below them they saw the white waters pour into a foaming bowl, and
  12.  * then swirl darkly about a deep oval basin in the rocks, until they found
  13.  * their way out again through a narrow gate, and flowed away, fuming and
  14.  * chattering, into calmer and more level reaches."
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  21. #include <sys/ipc.h>
  22. #ifdef HAS_MSG
  23. #include <sys/msg.h>
  24. #endif
  25. #ifdef HAS_SEM
  26. #include <sys/sem.h>
  27. #endif
  28. #ifdef HAS_SHM
  29. #include <sys/shm.h>
  30. # ifndef HAS_SHMAT_PROTOTYPE
  31.     extern Shmat_t shmat _((int, char *, int));
  32. # endif
  33. #endif
  34. #endif
  35.  
  36. #ifdef I_UTIME
  37. #include <utime.h>
  38. #endif
  39. #ifdef I_FCNTL
  40. #include <fcntl.h>
  41. #endif
  42. #ifdef I_SYS_FILE
  43. #include <sys/file.h>
  44. #endif
  45.  
  46. /* This IMHO belongs here MN 29Dec94 */
  47. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  48. # include <sys/socket.h>
  49. # include <netdb.h>
  50. # ifndef ENOTSOCK
  51. #  ifdef I_NET_ERRNO
  52. #   include <net/errno.h>
  53. #  endif
  54. # endif
  55. #endif
  56.  
  57. /* Omit -- it causes too much grief on mixed systems.
  58. #ifdef I_UNISTD
  59. #include <unistd.h>
  60. #endif
  61. */
  62.  
  63. bool
  64. do_open(gv,name,len,supplied_fp)
  65. GV *gv;
  66. register char *name;
  67. I32 len;
  68. FILE *supplied_fp;
  69. {
  70.     FILE *fp;
  71.     register IO *io = GvIOn(gv);
  72.     char *myname = savepv(name);
  73.     int result;
  74.     int fd;
  75.     int writing = 0;
  76.     int dodup;
  77.     char mode[3];        /* stdio file mode ("r\0" or "r+\0") */
  78.     FILE *saveifp = Nullfp;
  79.     FILE *saveofp = Nullfp;
  80.     char savetype = ' ';
  81.  
  82.     SAVEFREEPV(myname);
  83.     mode[0] = mode[1] = mode[2] = '\0';
  84.     name = myname;
  85.     forkprocess = 1;        /* assume true if no fork */
  86.     while (len && isSPACE(name[len-1]))
  87.     name[--len] = '\0';
  88.     if (IoIFP(io)) {
  89.     fd = fileno(IoIFP(io));
  90.     if (IoTYPE(io) == '-')
  91.         result = 0;
  92.     else if (fd <= maxsysfd) {
  93.         saveifp = IoIFP(io);
  94.         saveofp = IoOFP(io);
  95.         savetype = IoTYPE(io);
  96.         result = 0;
  97.     }
  98.     else if (IoTYPE(io) == '|')
  99.         result = my_pclose(IoIFP(io));
  100.     else if (IoIFP(io) != IoOFP(io)) {
  101.         if (IoOFP(io)) {
  102.         result = fclose(IoOFP(io));
  103.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  104.         }
  105.         else
  106.         result = fclose(IoIFP(io));
  107.     }
  108.     else
  109.         result = fclose(IoIFP(io));
  110.     if (result == EOF && fd > maxsysfd)
  111.         fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
  112.           GvENAME(gv));
  113.     IoOFP(io) = IoIFP(io) = Nullfp;
  114.     }
  115.     if (*name == '+' && len > 1 && name[len-1] != '|') {    /* scary */
  116.     mode[1] = *name++;
  117.     mode[2] = '\0';
  118.     --len;
  119.     writing = 1;
  120.     }
  121.     else  {
  122.     mode[1] = '\0';
  123.     }
  124.     IoTYPE(io) = *name;
  125.     if (*name == '|') {
  126.     /*SUPPRESS 530*/
  127.     for (name++; isSPACE(*name); name++) ;
  128.     if (strNE(name,"-"))
  129.         TAINT_ENV();
  130.     TAINT_PROPER("piped open");
  131.     if (dowarn && name[strlen(name)-1] == '|')
  132.         warn("Can't do bidirectional pipe");
  133.     fp = my_popen(name,"w");
  134.     writing = 1;
  135.     }
  136.     else if (*name == '>') {
  137.     TAINT_PROPER("open");
  138.     name++;
  139.     if (*name == '>') {
  140.         mode[0] = IoTYPE(io) = 'a';
  141.         name++;
  142.     }
  143.     else
  144.         mode[0] = 'w';
  145.     writing = 1;
  146.     if (*name == '&') {
  147.       duplicity:
  148.         dodup = 1;
  149.         name++;
  150.         if (*name == '=') {
  151.         dodup = 0;
  152.         name++;
  153.         }
  154.         if (!*name && supplied_fp)
  155.         fp = supplied_fp;
  156.         else {
  157.         while (isSPACE(*name))
  158.             name++;
  159.         if (isDIGIT(*name))
  160.             fd = atoi(name);
  161.         else {
  162.             IO* thatio;
  163.             gv = gv_fetchpv(name,FALSE,SVt_PVIO);
  164.             thatio = GvIO(gv);
  165.             if (!thatio) {
  166. #ifdef EINVAL
  167.             errno = EINVAL;
  168. #endif
  169.             goto say_false;
  170.             }
  171.             if (IoIFP(thatio)) {
  172.             fd = fileno(IoIFP(thatio));
  173.             if (IoTYPE(thatio) == 's')
  174.                 IoTYPE(io) = 's';
  175.             }
  176.             else
  177.             fd = -1;
  178.         }
  179.         if (dodup)
  180.             fd = dup(fd);
  181.         if (!(fp = fdopen(fd,mode)))
  182.             close(fd);
  183.         }
  184.     }
  185.     else {
  186.         while (isSPACE(*name))
  187.         name++;
  188.         if (strEQ(name,"-")) {
  189.         fp = stdout;
  190.         IoTYPE(io) = '-';
  191.         }
  192.         else  {
  193.         fp = fopen(name,mode);
  194.         }
  195.     }
  196.     }
  197.     else {
  198.     if (*name == '<') {
  199.         mode[0] = 'r';
  200.         name++;
  201.         while (isSPACE(*name))
  202.         name++;
  203.         if (*name == '&')
  204.         goto duplicity;
  205.         if (strEQ(name,"-")) {
  206.         fp = stdin;
  207.         IoTYPE(io) = '-';
  208.         }
  209.         else
  210.         fp = fopen(name,mode);
  211.     }
  212.     else if (name[len-1] == '|') {
  213.         name[--len] = '\0';
  214.         while (len && isSPACE(name[len-1]))
  215.         name[--len] = '\0';
  216.         /*SUPPRESS 530*/
  217.         for (; isSPACE(*name); name++) ;
  218.         if (strNE(name,"-"))
  219.         TAINT_ENV();
  220.         TAINT_PROPER("piped open");
  221.         fp = my_popen(name,"r");
  222.         IoTYPE(io) = '|';
  223.     }
  224.     else {
  225.         IoTYPE(io) = '<';
  226.         /*SUPPRESS 530*/
  227.         for (; isSPACE(*name); name++) ;
  228.         if (strEQ(name,"-")) {
  229.         fp = stdin;
  230.         IoTYPE(io) = '-';
  231.         }
  232.         else
  233.         fp = fopen(name,"r");
  234.     }
  235.     }
  236.     if (!fp) {
  237.     if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
  238.         warn(warn_nl, "open");
  239.     goto say_false;
  240.     }
  241.     if (IoTYPE(io) &&
  242.       IoTYPE(io) != '|' && IoTYPE(io) != '-') {
  243.     if (Fstat(fileno(fp),&statbuf) < 0) {
  244.         (void)fclose(fp);
  245.         goto say_false;
  246.     }
  247.     if (S_ISSOCK(statbuf.st_mode))
  248.         IoTYPE(io) = 's';    /* in case a socket was passed in to us */
  249. #ifdef HAS_SOCKET
  250.     else if (
  251. #ifdef S_IFMT
  252.         !(statbuf.st_mode & S_IFMT)
  253. #else
  254.         !statbuf.st_mode
  255. #endif
  256.     ) {
  257.         int buflen = sizeof tokenbuf;
  258.         if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
  259.         || errno != ENOTSOCK)
  260.         IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
  261.                 /* but some return 0 for streams too, sigh */
  262.     }
  263. #endif
  264.     }
  265.     if (saveifp) {        /* must use old fp? */
  266.     fd = fileno(saveifp);
  267.     if (saveofp) {
  268.         fflush(saveofp);        /* emulate fclose() */
  269.         if (saveofp != saveifp) {    /* was a socket? */
  270.         fclose(saveofp);
  271.         if (fd > 2)
  272.             Safefree(saveofp);
  273.         }
  274.     }
  275.     if (fd != fileno(fp)) {
  276.         int pid;
  277.         SV *sv;
  278.  
  279.         dup2(fileno(fp), fd);
  280.         sv = *av_fetch(fdpid,fileno(fp),TRUE);
  281.         (void)SvUPGRADE(sv, SVt_IV);
  282.         pid = SvIVX(sv);
  283.         SvIVX(sv) = 0;
  284.         sv = *av_fetch(fdpid,fd,TRUE);
  285.         (void)SvUPGRADE(sv, SVt_IV);
  286.         SvIVX(sv) = pid;
  287.         fclose(fp);
  288.  
  289.     }
  290.     fp = saveifp;
  291.     clearerr(fp);
  292.     }
  293. #if defined(HAS_FCNTL) && defined(F_SETFD)
  294.     fd = fileno(fp);
  295.     fcntl(fd,F_SETFD,fd > maxsysfd);
  296. #endif
  297.     IoIFP(io) = fp;
  298.     if (writing) {
  299.     if (IoTYPE(io) == 's'
  300.       || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
  301.         if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
  302.         fclose(fp);
  303.         IoIFP(io) = Nullfp;
  304.         goto say_false;
  305.         }
  306.     }
  307.     else
  308.         IoOFP(io) = fp;
  309.     }
  310.     return TRUE;
  311.  
  312. say_false:
  313.     IoIFP(io) = saveifp;
  314.     IoOFP(io) = saveofp;
  315.     IoTYPE(io) = savetype;
  316.     return FALSE;
  317. }
  318.  
  319. #ifdef macintosh
  320. #include <Files.h>
  321.  
  322. static FSSpec    EphTemp;
  323. static Boolean    HasEphKiller;
  324.  
  325. void EphKiller()
  326. {
  327.     if (EphTemp.name[0]) {
  328.         HDelete(EphTemp.vRefNum, EphTemp.parID, EphTemp.name);
  329.     EphTemp.name[0] = 0;
  330.     }
  331.     HasEphKiller = false;
  332. }
  333.  
  334. int Ephemeralize(char * name)
  335. {
  336.     FSSpec  old;
  337.     
  338.     if (Path2FSSpec(name, &old))
  339.         return ENOENT;
  340.     if (EphTemp.name[0] && EphTemp.vRefNum != old.vRefNum) {
  341.         HDelete(EphTemp.vRefNum, EphTemp.parID, EphTemp.name);
  342.     EphTemp.name[0] = 0;
  343.     }
  344.     if (!EphTemp.name[0] && Special2FSSpec('TMPF', old.vRefNum, 0, &EphTemp))
  345.         goto permErr;
  346.     
  347.     if (FSpSmartMove(&old, &EphTemp))
  348.         goto permErr;
  349.  
  350.     if (!HasEphKiller) {
  351.         atexit(EphKiller);
  352.     
  353.     HasEphKiller = true;
  354.     }
  355.  
  356.     return 0;
  357. permErr:
  358.     EphTemp.name[0] = 0;
  359.     
  360.     return EPERM;
  361. }
  362. #endif
  363.  
  364. FILE *
  365. nextargv(gv)
  366. register GV *gv;
  367. {
  368.     register SV *sv;
  369. #ifndef FLEXFILENAMES
  370.     int filedev;
  371.     int fileino;
  372. #endif
  373.     int fileuid;
  374.     int filegid;
  375.  
  376.     if (!argvoutgv)
  377.     argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
  378.     if (filemode & (S_ISUID|S_ISGID)) {
  379.     fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
  380. #ifdef HAS_FCHMOD
  381.     (void)fchmod(lastfd,filemode);
  382. #else
  383.     (void)chmod(oldname,filemode);
  384. #endif
  385.     }
  386.     filemode = 0;
  387.     while (av_len(GvAV(gv)) >= 0) {
  388.     STRLEN len;
  389.     sv = av_shift(GvAV(gv));
  390.     SAVEFREESV(sv);
  391.     sv_setsv(GvSV(gv),sv);
  392.     SvSETMAGIC(GvSV(gv));
  393.     oldname = SvPVx(GvSV(gv), len);
  394.     if (do_open(gv,oldname,len,Nullfp)) {
  395.         if (inplace) {
  396.         TAINT_PROPER("inplace open");
  397.         if (strEQ(oldname,"-")) {
  398.             defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
  399.             return IoIFP(GvIOp(gv));
  400.         }
  401. #ifndef FLEXFILENAMES
  402.         filedev = statbuf.st_dev;
  403.         fileino = statbuf.st_ino;
  404. #endif
  405.         filemode = statbuf.st_mode;
  406.         fileuid = statbuf.st_uid;
  407.         filegid = statbuf.st_gid;
  408.         if (!S_ISREG(filemode)) {
  409.             warn("Can't do inplace edit: %s is not a regular file",
  410.               oldname );
  411.             do_close(gv,FALSE);
  412.             continue;
  413.         }
  414.         if (*inplace) {
  415. #ifdef SUFFIX
  416.             add_suffix(sv,inplace);
  417. #else
  418.             sv_catpv(sv,inplace);
  419. #endif
  420. #ifndef FLEXFILENAMES
  421.             if (Stat(SvPVX(sv),&statbuf) >= 0
  422.               && statbuf.st_dev == filedev
  423.               && statbuf.st_ino == fileino ) {
  424.             warn("Can't do inplace edit: %s > 14 characters",
  425.               SvPVX(sv) );
  426.             do_close(gv,FALSE);
  427.             continue;
  428.             }
  429. #endif
  430. #ifdef HAS_RENAME
  431. #ifndef DOSISH
  432.             if (rename(oldname,SvPVX(sv)) < 0) {
  433.             warn("Can't rename %s to %s: %s, skipping file",
  434.               oldname, SvPVX(sv), Strerror(errno) );
  435.             do_close(gv,FALSE);
  436.             continue;
  437.             }
  438. #else
  439.             do_close(gv,FALSE);
  440.             (void)unlink(SvPVX(sv));
  441.             (void)rename(oldname,SvPVX(sv));
  442.             do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp);
  443. #endif /* MSDOS */
  444. #else
  445.             (void)UNLINK(SvPVX(sv));
  446.             if (link(oldname,SvPVX(sv)) < 0) {
  447.             warn("Can't rename %s to %s: %s, skipping file",
  448.               oldname, SvPVX(sv), Strerror(errno) );
  449.             do_close(gv,FALSE);
  450.             continue;
  451.             }
  452.             (void)UNLINK(oldname);
  453. #endif
  454.         }
  455.         else {
  456. #ifdef macintosh
  457.             if (errno = Ephemeralize(oldname)) {
  458.             warn("Can't rename %s to %s: %s, skipping file",
  459.               oldname, SvPVX(sv), Strerror(errno) );
  460.             do_close(gv,FALSE);
  461.             continue;
  462.             }
  463. #else
  464. #ifndef DOSISH
  465.             if (UNLINK(oldname) < 0) {
  466.             warn("Can't rename %s to %s: %s, skipping file",
  467.               oldname, SvPVX(sv), Strerror(errno) );
  468.             do_close(gv,FALSE);
  469.             continue;
  470.             }
  471. #else
  472.             croak("Can't do inplace edit without backup");
  473. #endif
  474. #endif
  475.         }
  476.  
  477.         sv_setpvn(sv,">",1);
  478.         sv_catpv(sv,oldname);
  479.         errno = 0;        /* in case sprintf set errno */
  480.         if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) {
  481.             warn("Can't do inplace edit on %s: %s",
  482.               oldname, Strerror(errno) );
  483.             do_close(gv,FALSE);
  484.             continue;
  485.         }
  486.         defoutgv = argvoutgv;
  487.         lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
  488.         (void)Fstat(lastfd,&statbuf);
  489. #ifdef HAS_FCHMOD
  490.         (void)fchmod(lastfd,filemode);
  491. #else
  492.         (void)chmod(oldname,filemode);
  493. #endif
  494.         if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
  495. #ifdef HAS_FCHOWN
  496.             (void)fchown(lastfd,fileuid,filegid);
  497. #else
  498. #ifdef HAS_CHOWN
  499.             (void)chown(oldname,fileuid,filegid);
  500. #endif
  501. #endif
  502.         }
  503.         }
  504.         return IoIFP(GvIOp(gv));
  505.     }
  506.     else
  507. #ifdef macintosh
  508.         fprintf(stderr,"# Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  509. #else
  510.         fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  511. #endif
  512.     }
  513.     if (inplace) {
  514.     (void)do_close(argvoutgv,FALSE);
  515.     defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
  516.     }
  517.     return Nullfp;
  518. }
  519.  
  520. #ifdef HAS_PIPE
  521. void
  522. do_pipe(sv, rgv, wgv)
  523. SV *sv;
  524. GV *rgv;
  525. GV *wgv;
  526. {
  527.     register IO *rstio;
  528.     register IO *wstio;
  529.     int fd[2];
  530.  
  531.     if (!rgv)
  532.     goto badexit;
  533.     if (!wgv)
  534.     goto badexit;
  535.  
  536.     rstio = GvIOn(rgv);
  537.     wstio = GvIOn(wgv);
  538.  
  539.     if (IoIFP(rstio))
  540.     do_close(rgv,FALSE);
  541.     if (IoIFP(wstio))
  542.     do_close(wgv,FALSE);
  543.  
  544.     if (pipe(fd) < 0)
  545.     goto badexit;
  546.     IoIFP(rstio) = fdopen(fd[0], "r");
  547.     IoOFP(wstio) = fdopen(fd[1], "w");
  548.     IoIFP(wstio) = IoOFP(wstio);
  549.     IoTYPE(rstio) = '<';
  550.     IoTYPE(wstio) = '>';
  551.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  552.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  553.     else close(fd[0]);
  554.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  555.     else close(fd[1]);
  556.     goto badexit;
  557.     }
  558.  
  559.     sv_setsv(sv,&sv_yes);
  560.     return;
  561.  
  562. badexit:
  563.     sv_setsv(sv,&sv_undef);
  564.     return;
  565. }
  566. #endif
  567.  
  568. bool
  569. #ifndef CAN_PROTOTYPE
  570. do_close(gv,explicit)
  571. GV *gv;
  572. bool explicit;
  573. #else
  574. do_close(GV *gv, bool explicit)
  575. #endif /* CAN_PROTOTYPE */
  576. {
  577.     bool retval = FALSE;
  578.     register IO *io;
  579.     int status;
  580.  
  581.     if (!gv)
  582.     gv = argvgv;
  583.     if (!gv || SvTYPE(gv) != SVt_PVGV) {
  584.     errno = EBADF;
  585.     return FALSE;
  586.     }
  587.     io = GvIO(gv);
  588.     if (!io) {        /* never opened */
  589.     if (dowarn && explicit)
  590.         warn("Close on unopened file <%s>",GvENAME(gv));
  591.     return FALSE;
  592.     }
  593.     if (IoIFP(io)) {
  594.     if (IoTYPE(io) == '|') {
  595.         status = my_pclose(IoIFP(io));
  596.         retval = (status == 0);
  597.         statusvalue = (unsigned short)status & 0xffff;
  598.     }
  599.     else if (IoTYPE(io) == '-')
  600.         retval = TRUE;
  601.     else {
  602.         if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {        /* a socket */
  603.         retval = (fclose(IoOFP(io)) != EOF);
  604.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  605.         }
  606.         else
  607.         retval = (fclose(IoIFP(io)) != EOF);
  608.     }
  609.     IoOFP(io) = IoIFP(io) = Nullfp;
  610.     }
  611.     if (explicit) {
  612.     IoLINES(io) = 0;
  613.     IoPAGE(io) = 0;
  614.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  615.     }
  616.     IoTYPE(io) = ' ';
  617.     return retval;
  618. }
  619.  
  620. bool
  621. do_eof(gv)
  622. GV *gv;
  623. {
  624.     register IO *io;
  625.     int ch;
  626.  
  627.     io = GvIO(gv);
  628.  
  629.     if (!io)
  630.     return TRUE;
  631.  
  632.     while (IoIFP(io)) {
  633.  
  634. #ifdef USE_STD_STDIO            /* (the code works without this) */
  635.     if (IoIFP(io)->_cnt > 0)    /* cheat a little, since */
  636.         return FALSE;        /* this is the most usual case */
  637. #endif
  638.  
  639.     ch = getc(IoIFP(io));
  640.     if (ch != EOF) {
  641.         (void)ungetc(ch, IoIFP(io));
  642.         return FALSE;
  643.     }
  644. #ifdef USE_STD_STDIO
  645.     if (IoIFP(io)->_cnt < -1)
  646.         IoIFP(io)->_cnt = -1;
  647. #endif
  648.     if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
  649.         if (!nextargv(argvgv))    /* get another fp handy */
  650.         return TRUE;
  651.     }
  652.     else
  653.         return TRUE;        /* normal fp, definitely end of file */
  654.     }
  655.     return TRUE;
  656. }
  657.  
  658. long
  659. do_tell(gv)
  660. GV *gv;
  661. {
  662.     register IO *io;
  663.  
  664.     if (!gv)
  665.     goto phooey;
  666.  
  667.     io = GvIO(gv);
  668.     if (!io || !IoIFP(io))
  669.     goto phooey;
  670.  
  671. #ifdef ULTRIX_STDIO_BOTCH
  672.     if (feof(IoIFP(io)))
  673.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  674. #endif
  675.  
  676.     return ftell(IoIFP(io));
  677.  
  678. phooey:
  679.     if (dowarn)
  680.     warn("tell() on unopened file");
  681.     errno = EBADF;
  682.     return -1L;
  683. }
  684.  
  685. bool
  686. do_seek(gv, pos, whence)
  687. GV *gv;
  688. long pos;
  689. int whence;
  690. {
  691.     register IO *io;
  692.  
  693.     if (!gv)
  694.     goto nuts;
  695.  
  696.     io = GvIO(gv);
  697.     if (!io || !IoIFP(io))
  698.     goto nuts;
  699.  
  700. #ifdef ULTRIX_STDIO_BOTCH
  701.     if (feof(IoIFP(io)))
  702.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  703. #endif
  704.  
  705.     return fseek(IoIFP(io), pos, whence) >= 0;
  706.  
  707. nuts:
  708.     if (dowarn)
  709.     warn("seek() on unopened file");
  710.     errno = EBADF;
  711.     return FALSE;
  712. }
  713.  
  714. #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
  715.     /* code courtesy of William Kucharski */
  716. #define HAS_CHSIZE
  717.  
  718. I32 chsize(fd, length)
  719. I32 fd;            /* file descriptor */
  720. Off_t length;        /* length to set file to */
  721. {
  722.     extern long lseek();
  723.     struct flock fl;
  724.     struct stat filebuf;
  725.  
  726.     if (Fstat(fd, &filebuf) < 0)
  727.     return -1;
  728.  
  729.     if (filebuf.st_size < length) {
  730.  
  731.     /* extend file length */
  732.  
  733.     if ((lseek(fd, (length - 1), 0)) < 0)
  734.         return -1;
  735.  
  736.     /* write a "0" byte */
  737.  
  738.     if ((write(fd, "", 1)) != 1)
  739.         return -1;
  740.     }
  741.     else {
  742.     /* truncate length */
  743.  
  744.     fl.l_whence = 0;
  745.     fl.l_len = 0;
  746.     fl.l_start = length;
  747.     fl.l_type = F_WRLCK;    /* write lock on file space */
  748.  
  749.     /*
  750.     * This relies on the UNDOCUMENTED F_FREESP argument to
  751.     * fcntl(2), which truncates the file so that it ends at the
  752.     * position indicated by fl.l_start.
  753.     *
  754.     * Will minor miracles never cease?
  755.     */
  756.  
  757.     if (fcntl(fd, F_FREESP, &fl) < 0)
  758.         return -1;
  759.  
  760.     }
  761.  
  762.     return 0;
  763. }
  764. #endif /* F_FREESP */
  765.  
  766. I32
  767. looks_like_number(sv)
  768. SV *sv;
  769. {
  770.     register char *s;
  771.     register char *send;
  772.  
  773.     if (!SvPOK(sv)) {
  774.     STRLEN len;
  775.     if (!SvPOKp(sv))
  776.         return TRUE;
  777.     s = SvPV(sv, len);
  778.     send = s + len;
  779.     }
  780.     else {
  781.     s = SvPVX(sv); 
  782.     send = s + SvCUR(sv);
  783.     }
  784.     while (isSPACE(*s))
  785.     s++;
  786.     if (s >= send)
  787.     return FALSE;
  788.     if (*s == '+' || *s == '-')
  789.     s++;
  790.     while (isDIGIT(*s))
  791.     s++;
  792.     if (s == send)
  793.     return TRUE;
  794.     if (*s == '.') 
  795.     s++;
  796.     else if (s == SvPVX(sv))
  797.     return FALSE;
  798.     while (isDIGIT(*s))
  799.     s++;
  800.     if (s == send)
  801.     return TRUE;
  802.     if (*s == 'e' || *s == 'E') {
  803.     s++;
  804.     if (*s == '+' || *s == '-')
  805.         s++;
  806.     while (isDIGIT(*s))
  807.         s++;
  808.     }
  809.     while (isSPACE(*s))
  810.     s++;
  811.     if (s >= send)
  812.     return TRUE;
  813.     return FALSE;
  814. }
  815.  
  816. bool
  817. do_print(sv,fp)
  818. register SV *sv;
  819. FILE *fp;
  820. {
  821.     register char *tmps;
  822.     STRLEN len;
  823.  
  824.     /* assuming fp is checked earlier */
  825.     if (!sv)
  826.     return TRUE;
  827.     if (ofmt) {
  828.     if (SvGMAGICAL(sv))
  829.         mg_get(sv);
  830.         if (SvIOK(sv) && SvIVX(sv) != 0) {
  831.         fprintf(fp, ofmt, (double)SvIVX(sv));
  832.         return !ferror(fp);
  833.     }
  834.     if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
  835.        || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
  836.         fprintf(fp, ofmt, SvNVX(sv));
  837.         return !ferror(fp);
  838.     }
  839.     }
  840.     switch (SvTYPE(sv)) {
  841.     case SVt_NULL:
  842.     if (dowarn)
  843.         warn(warn_uninit);
  844.     return TRUE;
  845.     case SVt_IV:
  846.     if (SvIOK(sv)) {
  847.         if (SvGMAGICAL(sv))
  848.         mg_get(sv);
  849.         fprintf(fp, "%ld", (long)SvIVX(sv));
  850.         return !ferror(fp);
  851.     }
  852.     /* FALL THROUGH */
  853.     default:
  854.     tmps = SvPV(sv, len);
  855.     break;
  856.     }
  857.     if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
  858.     return FALSE;
  859.     return TRUE;
  860. }
  861.  
  862. I32
  863. my_stat(ARGS)
  864. dARGS
  865. {
  866.     dSP;
  867.     IO *io;
  868.  
  869.     if (op->op_flags & OPf_REF) {
  870.     EXTEND(sp,1);
  871.     io = GvIO(cGVOP->op_gv);
  872.     if (io && IoIFP(io)) {
  873.         statgv = cGVOP->op_gv;
  874.         sv_setpv(statname,"");
  875.         laststype = OP_STAT;
  876.         return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
  877.     }
  878.     else {
  879.         if (cGVOP->op_gv == defgv)
  880.         return laststatval;
  881.         if (dowarn)
  882.         warn("Stat on unopened file <%s>",
  883.           GvENAME(cGVOP->op_gv));
  884.         statgv = Nullgv;
  885.         sv_setpv(statname,"");
  886.         return (laststatval = -1);
  887.     }
  888.     }
  889.     else {
  890.     dPOPss;
  891.     PUTBACK;
  892.     statgv = Nullgv;
  893.     sv_setpv(statname,SvPV(sv, na));
  894.     laststype = OP_STAT;
  895.     laststatval = Stat(SvPV(sv, na),&statcache);
  896.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  897.         warn(warn_nl, "stat");
  898.     return laststatval;
  899.     }
  900. }
  901.  
  902. I32
  903. my_lstat(ARGS)
  904. dARGS
  905. {
  906.     dSP;
  907.     SV *sv;
  908.     if (op->op_flags & OPf_REF) {
  909.     EXTEND(sp,1);
  910.     if (cGVOP->op_gv == defgv) {
  911.         if (laststype != OP_LSTAT)
  912.         croak("The stat preceding -l _ wasn't an lstat");
  913.         return laststatval;
  914.     }
  915.     croak("You can't use -l on a filehandle");
  916.     }
  917.  
  918.     laststype = OP_LSTAT;
  919.     statgv = Nullgv;
  920.     sv = POPs;
  921.     PUTBACK;
  922.     sv_setpv(statname,SvPV(sv, na));
  923. #ifdef HAS_LSTAT
  924.     laststatval = lstat(SvPV(sv, na),&statcache);
  925. #else
  926.     laststatval = Stat(SvPV(sv, na),&statcache);
  927. #endif
  928.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  929.     warn(warn_nl, "lstat");
  930.     return laststatval;
  931. }
  932.  
  933. bool
  934. do_aexec(really,mark,sp)
  935. SV *really;
  936. register SV **mark;
  937. register SV **sp;
  938. {
  939. #ifdef macintosh
  940.     croak("exec? I'm not *that* kind of operating system");
  941. #else
  942.     register char **a;
  943.     char *tmps;
  944.  
  945.     if (sp > mark) {
  946.     New(401,Argv, sp - mark + 1, char*);
  947.     a = Argv;
  948.     while (++mark <= sp) {
  949.         if (*mark)
  950.         *a++ = SvPVx(*mark, na);
  951.         else
  952.         *a++ = "";
  953.     }
  954.     *a = Nullch;
  955.     if (*Argv[0] != '/')    /* will execvp use PATH? */
  956.         TAINT_ENV();        /* testing IFS here is overkill, probably */
  957.     if (really && *(tmps = SvPV(really, na)))
  958.         execvp(tmps,Argv);
  959.     else
  960.         execvp(Argv[0],Argv);
  961.     if (dowarn)
  962.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  963.     }
  964.     do_execfree();
  965. #endif
  966.     return FALSE;
  967. }
  968.  
  969. void
  970. do_execfree()
  971. {
  972.     if (Argv) {
  973.     Safefree(Argv);
  974.     Argv = Null(char **);
  975.     }
  976.     if (Cmd) {
  977.     Safefree(Cmd);
  978.     Cmd = Nullch;
  979.     }
  980. }
  981.  
  982. bool
  983. do_exec(cmd)
  984. char *cmd;
  985. {
  986. #ifdef macintosh
  987.     croak("exec? I'm not *that* kind of operating system");
  988. #else
  989.     register char **a;
  990.     register char *s;
  991.     char flags[10];
  992.  
  993.     /* save an extra exec if possible */
  994.  
  995. #ifdef CSH
  996.     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
  997.     strcpy(flags,"-c");
  998.     s = cmd+cshlen+3;
  999.     if (*s == 'f') {
  1000.         s++;
  1001.         strcat(flags,"f");
  1002.     }
  1003.     if (*s == ' ')
  1004.         s++;
  1005.     if (*s++ == '\'') {
  1006.         char *ncmd = s;
  1007.  
  1008.         while (*s)
  1009.         s++;
  1010.         if (s[-1] == '\n')
  1011.         *--s = '\0';
  1012.         if (s[-1] == '\'') {
  1013.         *--s = '\0';
  1014.         execl(cshname,"csh", flags,ncmd,(char*)0);
  1015.         *s = '\'';
  1016.         return FALSE;
  1017.         }
  1018.     }
  1019.     }
  1020. #endif /* CSH */
  1021.  
  1022.     /* see if there are shell metacharacters in it */
  1023.  
  1024.     /*SUPPRESS 530*/
  1025.     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  1026.     if (*s == '=')
  1027.     goto doshell;
  1028.     for (s = cmd; *s; s++) {
  1029.     if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  1030.         if (*s == '\n' && !s[1]) {
  1031.         *s = '\0';
  1032.         break;
  1033.         }
  1034.       doshell:
  1035.         execl("/bin/sh","sh","-c",cmd,(char*)0);
  1036.         return FALSE;
  1037.     }
  1038.     }
  1039.     New(402,Argv, (s - cmd) / 2 + 2, char*);
  1040.     Cmd = savepvn(cmd, s-cmd);
  1041.     a = Argv;
  1042.     for (s = Cmd; *s;) {
  1043.     while (*s && isSPACE(*s)) s++;
  1044.     if (*s)
  1045.         *(a++) = s;
  1046.     while (*s && !isSPACE(*s)) s++;
  1047.     if (*s)
  1048.         *s++ = '\0';
  1049.     }
  1050.     *a = Nullch;
  1051.     if (Argv[0]) {
  1052.     execvp(Argv[0],Argv);
  1053.     if (errno == ENOEXEC) {        /* for system V NIH syndrome */
  1054.         do_execfree();
  1055.         goto doshell;
  1056.     }
  1057.     if (dowarn)
  1058.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  1059.     }
  1060.     do_execfree();
  1061. #endif
  1062.     return FALSE;
  1063. }
  1064.  
  1065. I32
  1066. apply(type,mark,sp)
  1067. I32 type;
  1068. register SV **mark;
  1069. register SV **sp;
  1070. {
  1071.     register I32 val;
  1072.     register I32 val2;
  1073.     register I32 tot = 0;
  1074.     char *s;
  1075.     SV **oldmark = mark;
  1076.  
  1077.     if (tainting) {
  1078.     while (++mark <= sp) {
  1079.         if (SvMAGICAL(*mark) && mg_find(*mark, 't'))
  1080.         tainted = TRUE;
  1081.     }
  1082.     mark = oldmark;
  1083.     }
  1084.     switch (type) {
  1085.     case OP_CHMOD:
  1086.     TAINT_PROPER("chmod");
  1087.     if (++mark <= sp) {
  1088.         tot = sp - mark;
  1089.         val = SvIVx(*mark);
  1090.         while (++mark <= sp) {
  1091.         if (chmod(SvPVx(*mark, na),val))
  1092.             tot--;
  1093.         }
  1094.     }
  1095.     break;
  1096. #ifdef HAS_CHOWN
  1097.     case OP_CHOWN:
  1098.     TAINT_PROPER("chown");
  1099.     if (sp - mark > 2) {
  1100.         val = SvIVx(*++mark);
  1101.         val2 = SvIVx(*++mark);
  1102.         tot = sp - mark;
  1103.         while (++mark <= sp) {
  1104.         if (chown(SvPVx(*mark, na),val,val2))
  1105.             tot--;
  1106.         }
  1107.     }
  1108.     break;
  1109. #endif
  1110. #ifdef HAS_KILL
  1111.     case OP_KILL:
  1112.     TAINT_PROPER("kill");
  1113.     s = SvPVx(*++mark, na);
  1114.     tot = sp - mark;
  1115.     if (isUPPER(*s)) {
  1116.         if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  1117.         s += 3;
  1118.         if (!(val = whichsig(s)))
  1119.         croak("Unrecognized signal name \"%s\"",s);
  1120.     }
  1121.     else
  1122.         val = SvIVx(*mark);
  1123.     if (val < 0) {
  1124.         val = -val;
  1125.         while (++mark <= sp) {
  1126.         I32 proc = SvIVx(*mark);
  1127. #ifdef HAS_KILLPG
  1128.         if (killpg(proc,val))    /* BSD */
  1129. #else
  1130.         if (kill(-proc,val))    /* SYSV */
  1131. #endif
  1132.             tot--;
  1133.         }
  1134.     }
  1135.     else {
  1136.         while (++mark <= sp) {
  1137.         if (kill(SvIVx(*mark),val))
  1138.             tot--;
  1139.         }
  1140.     }
  1141.     break;
  1142. #endif
  1143.     case OP_UNLINK:
  1144.     TAINT_PROPER("unlink");
  1145.     tot = sp - mark;
  1146.     while (++mark <= sp) {
  1147.         s = SvPVx(*mark, na);
  1148.         if (euid || unsafe) {
  1149.         if (UNLINK(s))
  1150.             tot--;
  1151.         }
  1152.         else {    /* don't let root wipe out directories without -U */
  1153. #ifdef HAS_LSTAT
  1154.         if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1155. #else
  1156.         if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1157. #endif
  1158.             tot--;
  1159.         else {
  1160.             if (UNLINK(s))
  1161.             tot--;
  1162.         }
  1163.         }
  1164.     }
  1165.     break;
  1166. #ifdef HAS_UTIME
  1167.     case OP_UTIME:
  1168.     TAINT_PROPER("utime");
  1169.     if (sp - mark > 2) {
  1170. #ifdef I_UTIME
  1171.         struct utimbuf utbuf;
  1172. #else
  1173.         struct {
  1174.         long    actime;
  1175.         long    modtime;
  1176.         } utbuf;
  1177. #endif
  1178.  
  1179.         Zero(&utbuf, sizeof utbuf, char);
  1180.         utbuf.actime = SvIVx(*++mark);    /* time accessed */
  1181.         utbuf.modtime = SvIVx(*++mark);    /* time modified */
  1182.         tot = sp - mark;
  1183.         while (++mark <= sp) {
  1184.         if (utime(SvPVx(*mark, na),&utbuf))
  1185.             tot--;
  1186.         }
  1187.     }
  1188.     else
  1189.         tot = 0;
  1190.     break;
  1191. #endif
  1192.     }
  1193.     return tot;
  1194. }
  1195.  
  1196. /* Do the permissions allow some operation?  Assumes statcache already set. */
  1197. #ifndef VMS /* VMS' cando is in vms.c */
  1198. I32
  1199. cando(bit, effective, statbufp)
  1200. I32 bit;
  1201. I32 effective;
  1202. register struct stat *statbufp;
  1203. {
  1204. #ifdef DOSISH
  1205.     /* [Comments and code from Len Reed]
  1206.      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
  1207.      * to write-protected files.  The execute permission bit is set
  1208.      * by the Miscrosoft C library stat() function for the following:
  1209.      *        .exe files
  1210.      *        .com files
  1211.      *        .bat files
  1212.      *        directories
  1213.      * All files and directories are readable.
  1214.      * Directories and special files, e.g. "CON", cannot be
  1215.      * write-protected.
  1216.      * [Comment by Tom Dinger -- a directory can have the write-protect
  1217.      *        bit set in the file system, but DOS permits changes to
  1218.      *        the directory anyway.  In addition, all bets are off
  1219.      *        here for networked software, such as Novell and
  1220.      *        Sun's PC-NFS.]
  1221.      */
  1222.  
  1223.      /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
  1224.       * too so it will actually look into the files for magic numbers
  1225.       */
  1226.      return (bit & statbufp->st_mode) ? TRUE : FALSE;
  1227.  
  1228. #else /* ! MSDOS */
  1229.     if ((effective ? euid : uid) == 0) {    /* root is special */
  1230.     if (bit == S_IXUSR) {
  1231.         if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
  1232.         return TRUE;
  1233.     }
  1234.     else
  1235.         return TRUE;        /* root reads and writes anything */
  1236.     return FALSE;
  1237.     }
  1238.     if (statbufp->st_uid == (effective ? euid : uid) ) {
  1239.     if (statbufp->st_mode & bit)
  1240.         return TRUE;    /* ok as "user" */
  1241.     }
  1242.     else if (ingroup((I32)statbufp->st_gid,effective)) {
  1243.     if (statbufp->st_mode & bit >> 3)
  1244.         return TRUE;    /* ok as "group" */
  1245.     }
  1246.     else if (statbufp->st_mode & bit >> 6)
  1247.     return TRUE;    /* ok as "other" */
  1248.     return FALSE;
  1249. #endif /* ! MSDOS */
  1250. }
  1251. #endif /* ! VMS */
  1252.  
  1253. I32
  1254. ingroup(testgid,effective)
  1255. I32 testgid;
  1256. I32 effective;
  1257. {
  1258. #ifdef macintosh
  1259.     /* This is simply not correct for AppleShare, but fix it yerself. */
  1260.     return TRUE;
  1261. #else
  1262.     if (testgid == (effective ? egid : gid))
  1263.     return TRUE;
  1264. #ifdef HAS_GETGROUPS
  1265. #ifndef NGROUPS
  1266. #define NGROUPS 32
  1267. #endif
  1268.     {
  1269.     Groups_t gary[NGROUPS];
  1270.     I32 anum;
  1271.  
  1272.     anum = getgroups(NGROUPS,gary);
  1273.     while (--anum >= 0)
  1274.         if (gary[anum] == testgid)
  1275.         return TRUE;
  1276.     }
  1277. #endif
  1278.     return FALSE;
  1279. #endif
  1280. }
  1281.  
  1282. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  1283.  
  1284. I32
  1285. do_ipcget(optype, mark, sp)
  1286. I32 optype;
  1287. SV **mark;
  1288. SV **sp;
  1289. {
  1290.     key_t key;
  1291.     I32 n, flags;
  1292.  
  1293.     key = (key_t)SvNVx(*++mark);
  1294.     n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
  1295.     flags = SvIVx(*++mark);
  1296.     errno = 0;
  1297.     switch (optype)
  1298.     {
  1299. #ifdef HAS_MSG
  1300.     case OP_MSGGET:
  1301.     return msgget(key, flags);
  1302. #endif
  1303. #ifdef HAS_SEM
  1304.     case OP_SEMGET:
  1305.     return semget(key, n, flags);
  1306. #endif
  1307. #ifdef HAS_SHM
  1308.     case OP_SHMGET:
  1309.     return shmget(key, n, flags);
  1310. #endif
  1311. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1312.     default:
  1313.     croak("%s not implemented", op_name[optype]);
  1314. #endif
  1315.     }
  1316.     return -1;            /* should never happen */
  1317. }
  1318.  
  1319. I32
  1320. do_ipcctl(optype, mark, sp)
  1321. I32 optype;
  1322. SV **mark;
  1323. SV **sp;
  1324. {
  1325.     SV *astr;
  1326.     char *a;
  1327.     I32 id, n, cmd, infosize, getinfo;
  1328.     I32 ret = -1;
  1329.  
  1330.     id = SvIVx(*++mark);
  1331.     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
  1332.     cmd = SvIVx(*++mark);
  1333.     astr = *++mark;
  1334.     infosize = 0;
  1335.     getinfo = (cmd == IPC_STAT);
  1336.  
  1337.     switch (optype)
  1338.     {
  1339. #ifdef HAS_MSG
  1340.     case OP_MSGCTL:
  1341.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1342.         infosize = sizeof(struct msqid_ds);
  1343.     break;
  1344. #endif
  1345. #ifdef HAS_SHM
  1346.     case OP_SHMCTL:
  1347.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1348.         infosize = sizeof(struct shmid_ds);
  1349.     break;
  1350. #endif
  1351. #ifdef HAS_SEM
  1352.     case OP_SEMCTL:
  1353.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1354.         infosize = sizeof(struct semid_ds);
  1355.     else if (cmd == GETALL || cmd == SETALL)
  1356.     {
  1357.         struct semid_ds semds;
  1358.         if (semctl(id, 0, IPC_STAT, &semds) == -1)
  1359.         return -1;
  1360.         getinfo = (cmd == GETALL);
  1361.         infosize = semds.sem_nsems * sizeof(short);
  1362.         /* "short" is technically wrong but much more portable
  1363.            than guessing about u_?short(_t)? */
  1364.     }
  1365.     break;
  1366. #endif
  1367. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1368.     default:
  1369.     croak("%s not implemented", op_name[optype]);
  1370. #endif
  1371.     }
  1372.  
  1373.     if (infosize)
  1374.     {
  1375.     STRLEN len;
  1376.     if (getinfo)
  1377.     {
  1378.         SvPV_force(astr, len);
  1379.         a = SvGROW(astr, infosize+1);
  1380.     }
  1381.     else
  1382.     {
  1383.         a = SvPV(astr, len);
  1384.         if (len != infosize)
  1385.         croak("Bad arg length for %s, is %d, should be %d",
  1386.             op_name[optype], len, infosize);
  1387.     }
  1388.     }
  1389.     else
  1390.     {
  1391.     I32 i = SvIV(astr);
  1392.     a = (char *)i;        /* ouch */
  1393.     }
  1394.     errno = 0;
  1395.     switch (optype)
  1396.     {
  1397. #ifdef HAS_MSG
  1398.     case OP_MSGCTL:
  1399.     ret = msgctl(id, cmd, (struct msqid_ds *)a);
  1400.     break;
  1401. #endif
  1402. #ifdef HAS_SEM
  1403.     case OP_SEMCTL:
  1404.     ret = semctl(id, n, cmd, (struct semid_ds *)a);
  1405.     break;
  1406. #endif
  1407. #ifdef HAS_SHM
  1408.     case OP_SHMCTL:
  1409.     ret = shmctl(id, cmd, (struct shmid_ds *)a);
  1410.     break;
  1411. #endif
  1412.     }
  1413.     if (getinfo && ret >= 0) {
  1414.     SvCUR_set(astr, infosize);
  1415.     *SvEND(astr) = '\0';
  1416.     SvSETMAGIC(astr);
  1417.     }
  1418.     return ret;
  1419. }
  1420.  
  1421. I32
  1422. do_msgsnd(mark, sp)
  1423. SV **mark;
  1424. SV **sp;
  1425. {
  1426. #ifdef HAS_MSG
  1427.     SV *mstr;
  1428.     char *mbuf;
  1429.     I32 id, msize, flags;
  1430.     STRLEN len;
  1431.  
  1432.     id = SvIVx(*++mark);
  1433.     mstr = *++mark;
  1434.     flags = SvIVx(*++mark);
  1435.     mbuf = SvPV(mstr, len);
  1436.     if ((msize = len - sizeof(long)) < 0)
  1437.     croak("Arg too short for msgsnd");
  1438.     errno = 0;
  1439.     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
  1440. #else
  1441.     croak("msgsnd not implemented");
  1442. #endif
  1443. }
  1444.  
  1445. I32
  1446. do_msgrcv(mark, sp)
  1447. SV **mark;
  1448. SV **sp;
  1449. {
  1450. #ifdef HAS_MSG
  1451.     SV *mstr;
  1452.     char *mbuf;
  1453.     long mtype;
  1454.     I32 id, msize, flags, ret;
  1455.     STRLEN len;
  1456.  
  1457.     id = SvIVx(*++mark);
  1458.     mstr = *++mark;
  1459.     msize = SvIVx(*++mark);
  1460.     mtype = (long)SvIVx(*++mark);
  1461.     flags = SvIVx(*++mark);
  1462.     if (SvTHINKFIRST(mstr)) {
  1463.     if (SvREADONLY(mstr))
  1464.         croak("Can't msgrcv to readonly var");
  1465.     if (SvROK(mstr))
  1466.         sv_unref(mstr);
  1467.     }
  1468.     SvPV_force(mstr, len);
  1469.     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
  1470.     
  1471.     errno = 0;
  1472.     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
  1473.     if (ret >= 0) {
  1474.     SvCUR_set(mstr, sizeof(long)+ret);
  1475.     *SvEND(mstr) = '\0';
  1476.     }
  1477.     return ret;
  1478. #else
  1479.     croak("msgrcv not implemented");
  1480. #endif
  1481. }
  1482.  
  1483. I32
  1484. do_semop(mark, sp)
  1485. SV **mark;
  1486. SV **sp;
  1487. {
  1488. #ifdef HAS_SEM
  1489.     SV *opstr;
  1490.     char *opbuf;
  1491.     I32 id;
  1492.     STRLEN opsize;
  1493.  
  1494.     id = SvIVx(*++mark);
  1495.     opstr = *++mark;
  1496.     opbuf = SvPV(opstr, opsize);
  1497.     if (opsize < sizeof(struct sembuf)
  1498.     || (opsize % sizeof(struct sembuf)) != 0) {
  1499.     errno = EINVAL;
  1500.     return -1;
  1501.     }
  1502.     errno = 0;
  1503.     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
  1504. #else
  1505.     croak("semop not implemented");
  1506. #endif
  1507. }
  1508.  
  1509. I32
  1510. do_shmio(optype, mark, sp)
  1511. I32 optype;
  1512. SV **mark;
  1513. SV **sp;
  1514. {
  1515. #ifdef HAS_SHM
  1516.     SV *mstr;
  1517.     char *mbuf, *shm;
  1518.     I32 id, mpos, msize;
  1519.     STRLEN len;
  1520.     struct shmid_ds shmds;
  1521.  
  1522.     id = SvIVx(*++mark);
  1523.     mstr = *++mark;
  1524.     mpos = SvIVx(*++mark);
  1525.     msize = SvIVx(*++mark);
  1526.     errno = 0;
  1527.     if (shmctl(id, IPC_STAT, &shmds) == -1)
  1528.     return -1;
  1529.     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
  1530.     errno = EFAULT;        /* can't do as caller requested */
  1531.     return -1;
  1532.     }
  1533.     shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
  1534.     if (shm == (char *)-1)    /* I hate System V IPC, I really do */
  1535.     return -1;
  1536.     if (optype == OP_SHMREAD) {
  1537.     SvPV_force(mstr, len);
  1538.     mbuf = SvGROW(mstr, msize+1);
  1539.  
  1540.     Copy(shm + mpos, mbuf, msize, char);
  1541.     SvCUR_set(mstr, msize);
  1542.     *SvEND(mstr) = '\0';
  1543.     SvSETMAGIC(mstr);
  1544.     }
  1545.     else {
  1546.     I32 n;
  1547.  
  1548.     mbuf = SvPV(mstr, len);
  1549.     if ((n = len) > msize)
  1550.         n = msize;
  1551.     Copy(mbuf, shm + mpos, n, char);
  1552.     if (n < msize)
  1553.         memzero(shm + mpos + n, msize - n);
  1554.     }
  1555.     return shmdt(shm);
  1556. #else
  1557.     croak("shm I/O not implemented");
  1558. #endif
  1559. }
  1560.  
  1561. #endif /* SYSV IPC */
  1562.